home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio / Ham Radio CD-ROM (Emerald Software) (1995).ISO / misc / hamutil2 / intermd2.bas < prev    next >
BASIC Source File  |  1984-09-05  |  5KB  |  145 lines
  1. 1000 '** Intermod Run
  2. 1010 '** Variables: a,b,c,d,e,f,g,h,j,k,r,t,x,y,a$,b$
  3. 1020 U1$="###.####\  \###.####\ \###.####  #.### MHz"
  4. 1030 U2$="###.####\  \###.####\ \###.####\ \###.####  #.### MHz"
  5. 1040 REM
  6. 1050 A = 0
  7. 1060 DIM T(100)
  8. 1070 CLS
  9. 1080 PRINT "             I N T E R M O D"
  10. 1090 A = A + 1
  11. 1100 INPUT "Enter Transmitter ";T(A)
  12. 1110 IF T(A)=0 GOTO 1140
  13. 1120 PRINT USING "\\ ##   ###.####";"T",A,T(A)
  14. 1130 GOTO 1090
  15. 1140 INPUT "Do you want a printout ? Enter (Y) (N)";A$
  16. 1150 IF A$="Y" THEN GOSUB 1370
  17. 1160 INPUT "Do you want to correct or add any transmitters ? (Y) (N)";A$
  18. 1170 IF A$<>"Y" GOTO 1210
  19. 1180 PRINT "Enter transmitter # to change or add(x)";A
  20. 1190 INPUT "Enter new transmitter frequency";T(A)
  21. 1200 GOTO 1160
  22. 1210 INPUT "Do you want a printout again ? (Y) (N)";A$
  23. 1220 IF A$="Y" THEN GOSUB 1370
  24. 1230                             ' START Transmitter bubble sort
  25. 1240 A=0
  26. 1250 F=1                         ' Set flag
  27. 1260 A=A+1                       ' Step a up one
  28. 1270 IF T(A+1)=0 GOTO 1300       ' Check for out of data
  29. 1280 IF T(A)>T(A+1) GOTO 1320    ' Go to switch
  30. 1290 GOTO 1260                   ' Fetch another
  31. 1300 IF F=0 GOTO 1240            ' Out of data, go again
  32. 1310 GOTO 1430                   ' Out of data and flag set
  33. 1320 X=T(A)                      ' Save t(a)
  34. 1330 T(A)=T(A+1)                 ' Swap
  35. 1340 T(A+1)=X                    ' Swap
  36. 1350 F=0                         ' Reset flag
  37. 1360 GOTO 1260                   ' Fetch another
  38. 1370 LPRINT CHR$(12);TAB(5);"Transmitters";CHR$(10)
  39. 1380 A=0
  40. 1390 A=A+1
  41. 1400 IF T(A)=0 THEN RETURN
  42. 1410 LPRINT USING "\\ ##   ###.####";"t",A,T(A)
  43. 1420 GOTO 1390
  44. 1430 D=0                        ' Input data: Receivers
  45. 1440 DIM R(100)
  46. 1450 CLS
  47. 1460 D = D + 1
  48. 1470 INPUT "Enter Receiver ";R(D)
  49. 1480 IF R(D)=0 GOTO 1510
  50. 1490 PRINT USING "\\ ##   ###.####";"R",D,R(D)
  51. 1500 GOTO 1460
  52. 1510 INPUT "Do you want a printout ? Enter (Y) (N)";A$
  53. 1520 IF A$="Y" THEN GOSUB 1740
  54. 1530 INPUT "Do you want to correct or add any Receivers ? (Y) (N)";A$
  55. 1540 IF A$<>"Y" GOTO 1580
  56. 1550 PRINT "Enter Receiver # to change or add(x)";D
  57. 1560 INPUT "Enter new Receiver frequency";R(D)
  58. 1570 GOTO 1530
  59. 1580 INPUT "Do you want a printout again ? (Y) (N)";A$
  60. 1590 IF A$="Y" THEN GOSUB 1740
  61. 1600                            ' START Receiver bubble sort"
  62. 1610 D=0
  63. 1620 F=1                        ' Set flag
  64. 1630 D=D+1                      ' Step d up one
  65. 1640 IF R(D+1)=0 GOTO 1670      ' Check for out of data
  66. 1650 IF R(D)>R(D+1) GOTO 1690   ' Go to switch
  67. 1660 GOTO 1630                  ' Fetch another
  68. 1670 IF F=0 GOTO 1610           ' Out of data, go again
  69. 1680 GOTO 1800                  ' Out of data and flag set
  70. 1690 X=R(D)                     ' Save r(d)
  71. 1700 R(D)=R(D+1)                ' Swap
  72. 1710 R(D+1)=X                   ' Swap
  73. 1720 F=0                        ' Reset flag
  74. 1730 GOTO 1630                  ' Fetch another
  75. 1740 LPRINT CHR$(12);TAB(5);"Receivers";CHR$(10)
  76. 1750 D=0
  77. 1760 D=D+1
  78. 1770 IF R(D)=0 THEN RETURN
  79. 1780 LPRINT USING "\\ ##   ###.####";"R",D,R(D)
  80. 1790 GOTO 1760
  81. 1800 K=0                        ' Start IM calculations
  82. 1810 K=K+1
  83. 1820 IF K=4 GOTO 2100
  84. 1830 ON K GOSUB 1950,1980,2010
  85. 1840 A=1
  86. 1850 E=1
  87. 1860 E=E+1
  88. 1870 IF E=A GOTO 1900
  89. 1880 ON K GOSUB 2040,2060,2080
  90. 1890 GOSUB 2290
  91. 1900 IF T(E)<>0 GOTO 1860
  92. 1910 IF T(A)=0 GOTO 1810
  93. 1920 A=A+1
  94. 1930 E=1
  95. 1940 GOTO 1870
  96. 1950 LPRINT CHR$(10);"  Third order INTERMOD products";CHR$(10)
  97. 1960 LPRINT " Receiver   2X Trans    Trans      +/- "
  98. 1970 RETURN
  99. 1980 LPRINT CHR$(10);"  Fifth order INTERMOD products";CHR$(10)
  100. 1990 LPRINT " Receiver   3X Trans   2X trans    +/-"
  101. 2000 RETURN
  102. 2010 LPRINT CHR$(10);"  Seventh order INTERMOD Products";CHR$(10)
  103. 2020 LPRINT " Receiver   4X Trans   3X Trans    +/-"
  104. 2030 RETURN
  105. 2040 G=T(A)+T(A)-T(E)
  106. 2050 RETURN
  107. 2060 G=T(A)+T(A)+T(A)-T(E)-T(E)
  108. 2070 RETURN
  109. 2080 G=T(A)+T(A)+T(A)+T(A)-T(E)-T(E)-T(E)
  110. 2090 RETURN
  111. 2100 LPRINT CHR$(10);" Three Transmitter, 3rd order products";CHR$(10)
  112. 2110 LPRINT " Receiver    Trans       Trans     Trans     +/-"
  113. 2120 A=1
  114. 2130 B=2
  115. 2140 C=2
  116. 2150 C=C+1
  117. 2160 IF C=A OR C=B GOTO 2190
  118. 2170 G=T(A)+T(B)-T(C)
  119. 2180 GOSUB 2290
  120. 2190 IF T(C+1)<>0 GOTO 2150
  121. 2200 IF T(B+1)=0 GOTO 2240
  122. 2210 B=B+1
  123. 2220 C=1
  124. 2230 GOTO 2160
  125. 2240 IF T(A+2)=0 GOTO 2420
  126. 2250 A=A+1
  127. 2260 B=A+1
  128. 2270 C=1
  129. 2280 GOTO 2160
  130. 2290 D=0                        ' Compare subroutines
  131. 2300 REM
  132. 2310 REM
  133. 2320 D=D+1
  134. 2330 IF R(D)=0 GOTO 2380
  135. 2340 H=(G-R(D))
  136. 2350 J=ABS(H)
  137. 2360 IF J>.0125 GOTO 2320
  138. 2370 ON K GOSUB 2390,2390,2390,2410
  139. 2380 RETURN
  140. 2390 LPRINT USING U1$;R(D)," =",T(A)," -",T(E),H
  141. 2400 RETURN
  142. 2410 LPRINT USING U2$;R(D)," =",T(A)," +",T(B)," -",T(C),H
  143. 2420 SYSTEM
  144. 2430 END
  145.